Shareware Grab Bag/Shareware Grab Bag.iso/090/pctj1086.arc/LOWEGA.MOD

Text File | 1986-08-15 | 28KB | 789 lines

IMPLEMENTATION MODULE LowEGA;
(*
Title   : LowEGA

          Low level EGA facilities
          Supplies useful workarounds to the Bios and
          extensions thereto such as split screen.
LastEdit: July 14, 1986
Author  : John T. Cockerham, M.D.
System  : LOGITECH MODULA-2/86
*)
                  (* This is a low level module*)
  FROM SYSTEM IMPORT INBYTE, OUTBYTE, OUTWORD, AX, BX, CX, DX, ES,
       ADR, BP, GETREG, SETREG, SWI, ADDRESS, CODE, BYTE, WORD;
  FROM PointLib IMPORT Point, MakePoint;
  FROM Opcodes IMPORT PushBP, PopBP;
  TYPE
    Register =  RECORD CASE BOOLEAN OF TRUE : X : CARDINAL;
                                    | FALSE : L, H : CHAR; END; END;
    ByteADRType = RECORD
            CASE BOOLEAN OF  TRUE : adr : POINTER TO CHAR;
                          | FALSE : off, seg : CARDINAL; END; END;

  CONST
            TotalScanLinesEnhanced = 349;
            VIDEO = 10H;
            SetPageBiosCall = 005H;
            SetPaletteCall  = 010H;
            CharacterGeneratorFunction = 011H;
            WriteTTY = 00EH;
            SetCPos = 002H;
            AlphaPageSize = 2048;
            BottomOfScreen = 01FFH;

         (* This is the bit layout for Info and Info3 -- EGA
            information bytes found the Bios page *)
            CursorEmulateBit = 0;   MonoAttachedBit = 1;
            WaitForEnableBit = 2;   EGAIsActiveBit  = 3;
            MemoryBit1       = 5;   MemoryBit2      = 6;
            ModeSetClearBit  = 7;

            VerticalRetraceBit = 3;

         (* These are EGA IO registers *)
     Graph1          = 03CCh; Graph2          = 03CAh;
     Graph12         = 03CEh; MiscOut         = 03C2h;
     Status0         = 03C2h; Sequencer       = 03C4h;
     AttributeCntrl  = 03C0h; GraphData       = 03CFh;
     StatusRegisterOffset = 6;
         (* These are the names of the EGA indices *)
         (* Sequencer controller first *)
     SequenceReset     = 0;     SequenceClockMode = 1;
     SequenceMapMask   = 2;     SequenceCharMap   = 3;
     SequenceMemMode   = 4;
         (* CRT controller registers *)
     CRTHorizTotal    = 00h;     CRTHorizEnd      = 01h;
     CRTHorizBlStart  = 02h;     CRTHorizBlEnd    = 03h;
     CRTHorizRetStart = 04h;     CRTHorizRetEnd   = 05h;
     CRTVertTotal     = 06h;     CRTOvflo         = 07h;
     CRTPreRowScan    = 08h;     CRTMaxScanLine   = 09h;
     CRTCursorStart   = 0Ah;     CRTCursorEnd     = 0Bh;
     CRTStartAddHi    = 0Ch;     CRTStartAddLo    = 0Dh;
     CRTCursLocHi     = 0Eh;     CRTCursLocLo     = 0Fh;
     CRTVertRetSt     = 10h;     CRTLightPenHi    = 10h;
     CRTVertRetEnd    = 11h;     CRTLightPenLo    = 11h;
     CRTVertDisEnd    = 12h;     CRTOffset        = 13h;
     CRTUnderLoc      = 14h;     CRTVertBlSt      = 15h;
     CRTVertBlEnd     = 16h;     CRTModeControl   = 17h;
     CRTLineCompare   = 18h;
        (* Graphics Controller indices *)
     GraphReset       = 00h;     GraphEnable      = 01h;
     GraphColorComp   = 02h;     GraphDataRotate  = 03h;
     GraphReadMapSel  = 04h;     GraphModeReg     = 05h;
     GraphMisc        = 06h;     GraphColorDC     = 07h;
     GraphBitMask     = 08h;
        (* Memory Mapping mode values *)
     A000x128K        = 00h;     A000x64K         = 04h;
     B000x32K         = 08h;     B800x32K         = 0Ch;
     GraphicsModeBit  = 01h;     ChainEvenToOdd   = 02h;
        (* Attribute Controller indices *)
     AttrModeControl  = 10h;     AttrOverscan     = 11h;
     AttrColorPlane   = 12h;     AttrHorizPelPan  = 13h;
     PaletteOn        = 20h;

  VAR
     VIDEORAM             : ByteADRType;
     bitmasks             : ARRAY [0..7] OF CARDINAL;
     Cursors              : ARRAY [0..7] OF Point;
     ActivePageOffsets    : ARRAY [0..7] OF CARDINAL;
     i                    : CARDINAL;
     CRTCOverflowRegister : BITSET;
     PelScrollColumn      : INTEGER;
     VerticalScrollRow    : INTEGER;
     SplitScreenLine      : CARDINAL;
     EGA6845              : CARDINAL;

(*$S-*)(*$T-*)(*$R-  Turn off Stack Checking for performance
                     and reentrancy reasons *)
  PROCEDURE EGAOutWord(EGAPort, DeviceRegister, Value : CARDINAL);
    (*Output two bytes to the EGA at two successive IO addresses *)
    VAR A : Register;
  BEGIN
    A.L := CHR(DeviceRegister); A.H := CHR(Value);
    OUTWORD(EGAPort, A.X);
  END EGAOutWord;

  PROCEDURE WaitForVerticalRetrace;
    (* Wait in a tight loop for vertical retrace *)
    VAR InputStatusRegister1 : BITSET;
  BEGIN
    REPEAT
        INBYTE(EGA6845 + StatusRegisterOffset,InputStatusRegister1);
    UNTIL VerticalRetraceBit IN InputStatusRegister1;
  END WaitForVerticalRetrace;

  PROCEDURE WaitForVerticalDisplay;
    (* Wait in a tight loop for vertical display active *)
    VAR InputStatusRegister1 : BITSET;
  BEGIN
    REPEAT
        INBYTE(EGA6845 + StatusRegisterOffset,InputStatusRegister1);
    UNTIL NOT (VerticalRetraceBit IN InputStatusRegister1);
  END WaitForVerticalDisplay;

  PROCEDURE SetPageOffset(where : CARDINAL);
    (* Instruct the CRTC where the page starts after retrace *)
    VAR   A : Register;
  BEGIN
    A.X := ActivePageOffset;
    WaitForVerticalRetrace;
    EGAOutWord(EGA6845, CRTStartAddHi,  ORD(A.H));
    EGAOutWord(EGA6845, CRTStartAddLo,  ORD(A.L));
  END SetPageOffset;

  PROCEDURE SetActiveFonts(FontA, FontB : CARDINAL);
    (* This routine changes the active character map for
       text modes. It is written as a reentrant procedure *)
    VAR x : CARDINAL;
  BEGIN
    x := FontA * 2 + FontB;
    WaitForVerticalRetrace;
    EGAOutWord(Sequencer, SequenceCharMap, x);
  END SetActiveFonts;

  (*$S+*)(*$T+*)(*$R+ Turn run time services back on*)

  PROCEDURE InitEGA(EGAMonitor : MonitorType) : BOOLEAN;
    (* This routine sets up the EGA for alpha Mode 3 *)
  BEGIN
    SetUpAlpha;   MemoryInstalled := 0;
    IF MemoryBit2 IN EGABiosParams.InfoAndInfo3
       THEN MemoryInstalled := 2 END;
    IF MemoryBit1 IN EGABiosParams.InfoAndInfo3
       THEN INC(MemoryInstalled) END;
    IF EGAMonitor = Monochrome THEN
      IF MonoAttachedBit IN EGABiosParams.InfoAndInfo3 THEN
        EGA6845 := 03B4H;
      ELSE
        RETURN FALSE;
      END;
    ELSE
      IF NOT (MonoAttachedBit IN EGABiosParams.InfoAndInfo3) THEN
        EGA6845 := 03D4H;
      ELSE
        RETURN FALSE;
      END;
      RETURN TRUE;
    END;
  END InitEGA;

  PROCEDURE SetUpAlpha;
    (*This is a non standard set up to the EGA to Alpha
      80X25 on the graphics page (A000).  Assertion that EGA
      is already in mode 3 and EGA is configured with 256K RAM *)
    VAR
      a, b : Register;
  BEGIN
      EGAOutWord(Graph12, GraphMisc,
            A000x64K + ChainEvenToOdd); (* Map to the A000 map *)
      EGAOutWord(EGA6845, CRTOvflo, 01FH);
      CRTCOverflowRegister := {4, 3, 2, 1, 0}
  END SetUpAlpha;

  PROCEDURE SetUpHiRes;
    (* This routine changes the EGA operating mode to HiRes color
       graphics. All of these register settings are from the
       boards' documentation  *)
  BEGIN
    WaitForVerticalRetrace;
    EGAOutWord(Sequencer, SequenceMapMask,  00FH);
    EGAOutWord(Sequencer, SequenceMemMode,  006H);
    EGAOutWord(EGA6845, CRTHorizRetStart,  052H);
    EGAOutWord(EGA6845, CRTHorizRetEnd,  000H);
    EGAOutWord(EGA6845, CRTOvflo,  01FH);
    CRTCOverflowRegister := {4, 3, 2, 1, 0};
    ResetVerticalScroll;
    ResetSplitScreen;
    EGAOutWord(EGA6845, CRTMaxScanLine,  000H);
    EGAOutWord(EGA6845, CRTCursorStart,  01FH); (*Turn off cursor*)
    EGAOutWord(EGA6845, CRTCursorEnd,  000H);
    EGAOutWord(EGA6845, CRTVertBlSt,  05FH);
    EGAOutWord(EGA6845, CRTModeControl,  0E3H); (*Byte Mode *)
    EGAOutWord(EGA6845, CRTLineCompare,  0FFH);
    EGAOutWord(Graph12, GraphModeReg,  000H);
    EGAOutWord(Graph12, GraphMisc,  A000x64K + GraphicsModeBit);
    EGAOutWord(Graph12, GraphColorDC,  00FH);
    EGAOutWord(AttributeCntrl, AttrModeControl+PaletteOn, 001H);
    ResetHorizScroll;
    (* We are in writing mode 0 with all maps on this will
       clear out the display buffer *)
    FOR i := 0 TO 65500 DO DisplayBuffer[i] := 0C; END;
  END SetUpHiRes;

  (*----------------------------------------------------*)
  (*        Position fiddling procedures                *)
  (*            Warning for these routines:             *)
  (*               Knowledge of exact mode              *)
  (*               specifications including word/byte   *)
  (*               count by 2 etc is essential to using *)
  (*               these routines                       *)
  (*----------------------------------------------------*)

  PROCEDURE SetLogicalRowSize(RowSizeInWords : CARDINAL);
    (* This routine sets the offset register of the CRTC. Word/byte
       issues play a role in its setting *)
  BEGIN
    EGAOutWord(EGA6845, CRTOffset, RowSizeInWords);
  END SetLogicalRowSize;

  PROCEDURE SetUnderlineLocation(UnderlineScanLine : CARDINAL);
    (* Set the CRTC's scan line for underlining *)
  BEGIN
    EGAOutWord(EGA6845, CRTUnderLoc, UnderlineScanLine);
  END SetUnderlineLocation;

  (*----------------------------------------------------*)
  (*      Mode Switching routines between the monitors  *)
  (*      Warning -- Two monitor systems only           *)
  (*                 Bad results can happen if on mono  *)
  (*                    systems only!                   *)
  (*----------------------------------------------------*)

  VAR
           EquipFlag     [0:410H]    : BITSET;

  PROCEDURE SwitchToMonoBios;
    (* Adjust the Equipment Flag to indicate a Monochrome System *)
  BEGIN
    EquipFlag := EquipFlag + {4, 5};
  END SwitchToMonoBios;

  PROCEDURE SwitchToColorBios;
    (* Adjust the Bios Equipment Flag to indicate Color system *)
  BEGIN
    EquipFlag := EquipFlag - {4} + {5};
  END SwitchToColorBios;

  PROCEDURE ColorBiosMode() : BOOLEAN;
    (* Return the status of the Flag. False = Monochrome,
       true = Color. *)
  BEGIN
    RETURN (NOT ((5 IN EquipFlag) AND (4 IN EquipFlag)));
  END ColorBiosMode;


(*------------------------------------------------------*)
(*   Cursor Routines                                    *)
(*------------------------------------------------------*)

  PROCEDURE SetCursor(Page : CARDINAL);
    (* Set the Cursor to display for the given page *)
    VAR  Off : Register;
  BEGIN
    Off.X := CursorOffset(Page) DIV 2;
    EGAOutWord(EGA6845, CRTCursLocHi, ORD(Off.H));
    EGAOutWord(EGA6845, CRTCursLocLo, ORD(Off.L));
  END SetCursor;

  PROCEDURE CursorOffset(Page : CARDINAL) : CARDINAL;
    (* Calculate cursor offset for CPU mappings: which is doubled
       accouting for the attribute byte *)
  BEGIN
    RETURN ((ActivePageOffsets[Page] +
       CARDINAL(Cursors[Page].y) * ORD(BiosCRTParams.CRTCols) +
       CARDINAL(Cursors[Page].x)) * 2);
  END CursorOffset;

  PROCEDURE BumpCursor(Page : CARDINAL);
    (*Increment the cursor in the X direction one unit. If the cursor
      falls off the row, reset to the beginning of the next row. Rows
      wrap around to the start of the screen *)
  BEGIN
    INC(Cursors[Page].x);
    IF Cursors[Page].x >= INTEGER(BiosCRTParams.CRTCols) THEN
      Cursors[Page].x := 0;
      INC(Cursors[Page].y);
      IF ORD(Cursors[Page].y) > ORD(RowsOnScreen) THEN
        Cursors[Page].y := 0;
      END;
    END;
    IF Page = ActivePage THEN SetCursor(Page); END;
  END BumpCursor;

  PROCEDURE SetCursorPoint(Page : CARDINAL; p : Point);
    (* Set the cursor to point 'p'. Don't allow it to fall off
       either edge of the display *)
  BEGIN
    IF p.x < INTEGER(BiosCRTParams.CRTCols) THEN
      Cursors[Page].x := p.x;
    ELSE
      Cursors[Page].x := INTEGER(BiosCRTParams.CRTCols) - 1;
    END;
    IF p.y <= INTEGER(ORD(RowsOnScreen)) THEN
      Cursors[Page].y := p.y;
    ELSE
      Cursors[Page].y := ORD(RowsOnScreen);
    END;
    IF Page = ActivePage THEN SetCursor(Page); END;
  END SetCursorPoint;

  PROCEDURE GetCursorPoint(VAR p : Point; Page : CARDINAL);
    (* Return the cursor position for the given page *)
  BEGIN
    p := Cursors[Page];
  END GetCursorPoint;


  (*----------------------------------------------------*)
  (*    Alpha mode write routines                       *)
  (*----------------------------------------------------*)

  PROCEDURE Write(Page : CARDINAL; ch : CHAR; color : INTEGER);
    (* Place one character into the display buffer at the
       cursor. The cursor in moved to the next column.
       Color represents the attribute byte *)
    VAR   x : CARDINAL;
  BEGIN
    x := CursorOffset(Page);
    DisplayBuffer[x] := ch;
    DisplayBuffer[x+1] := CHR(color);
    BumpCursor(Page);
  END Write;

  PROCEDURE WriteString(Page: CARDINAL; s : ARRAY OF CHAR;
                        c : CARDINAL);
    (* Place a string into the display buffer at the cursor.
       The string is written one character at a time with
       the attribute byte of c *)
    VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE i <= HIGH(s) DO
      Write(Page, s[i], c);
      INC(i);
    END;
  END WriteString;

  (*----------------------------------------------------*)
  (*    Virtual page manipulation routines              *)
  (*----------------------------------------------------*)

  PROCEDURE SetActivePage(page : CARDINAL);
    (* Set the active display page to 'page' resetting
       any scrolling etc. *)
  BEGIN
    ActivePage := page;
    ResetHorizScroll;
    ResetVerticalScroll;
    IF page <= MaxVideoPages THEN
      ActivePageOffset := ActivePageOffsets[page];
      SetPageOffset(ActivePageOffset);
      SetCursor(page);
    END;
  END SetActivePage;

  PROCEDURE MakeSecondGraphicsPage;
    (* This routine arbitrarily sets the offset to the
       second hi res graphics page *)
  BEGIN
    ActivePageOffset := 8000H;
    SetPageOffset(ActivePageOffset);
    SetBiosPage(1);
  END MakeSecondGraphicsPage;

  PROCEDURE ResetVideoPage;
    (*This routine resets the current video page, and
      get rid of any scrolling and split screens, etc.*)
  BEGIN
    SetActivePage(ActivePage);
    ResetSplitScreen;
  END ResetVideoPage;

  (*----------------------------------------------------*)
  (*      Attribute manipulation routines               *)
  (*----------------------------------------------------*)

  PROCEDURE SetPalette(Palette, Color : CARDINAL);
    (* This routine sets up the palette RAM in the
       attribute controller with the pattern in Color *)
  BEGIN
    WaitForVerticalRetrace;
    EGAOutWord(AttributeCntrl, Palette, Color);
    EGAOutWord(AttributeCntrl, AttrColorPlane+PaletteOn, 0FH);
  END SetPalette;

  PROCEDURE SetOverscan(Color : CARDINAL);
    (* This routine sets up the overscan color for a border
       with the pattern in Color *)
  BEGIN
    WaitForVerticalRetrace;
    EGAOutWord(AttributeCntrl, AttrOverscan, Color);
    EGAOutWord(AttributeCntrl, AttrColorPlane+PaletteOn, 0FH);
  END SetOverscan;

  PROCEDURE TurnOnBlinking;
  BEGIN
    EGAOutWord(AttributeCntrl, AttrModeControl+PaletteOn, 09H);
  END TurnOnBlinking;

  PROCEDURE TurnOffBlinking;
  BEGIN
    EGAOutWord(AttributeCntrl, AttrModeControl+PaletteOn, 01H);
  END TurnOffBlinking;

  (*----------------------------------------------------*)
  (*     Horizontal scrolling routines                  *)
  (*----------------------------------------------------*)

  PROCEDURE HorScrollLeft;
    (* Horizontal scrolling left means advancing the page offset
       when falling off the pixel box. The routine is specific
       for 8 pixels per byte  *)
  BEGIN
    INC(PelScrollColumn);
    WaitForVerticalDisplay;
    IF PelScrollColumn > 7 THEN
      PelScrollColumn := 0;
      INC(ActivePageOffset);
      SetPageOffset(ActivePageOffset);  (* Does a Wait already*)
      EGAOutWord(AttributeCntrl, AttrHorizPelPan+PaletteOn,
                 PelScrollColumn);
    ELSE;
      WaitForVerticalRetrace;
      EGAOutWord(AttributeCntrl, AttrHorizPelPan+PaletteOn,
                 PelScrollColumn);
    END;
  END HorScrollLeft;

  PROCEDURE HorScrollRight;
  BEGIN
    DEC(PelScrollColumn);
    WaitForVerticalDisplay;
    IF PelScrollColumn < 0 THEN
      PelScrollColumn := 7;
      DEC(ActivePageOffset);
      SetPageOffset(ActivePageOffset);
      EGAOutWord(AttributeCntrl, AttrHorizPelPan+PaletteOn,
                 PelScrollColumn);
    ELSE
      WaitForVerticalRetrace;
      EGAOutWord(AttributeCntrl, AttrHorizPelPan+PaletteOn,
                 PelScrollColumn);
    END;
  END HorScrollRight;

  PROCEDURE HorizScroll(pixels : INTEGER);
    VAR i : INTEGER;
  BEGIN
    IF pixels = 0 THEN RETURN; END;
    IF pixels > 0 THEN
      FOR i := 1 TO pixels DO HorScrollLeft; END;
    ELSE
      FOR i := -1 TO pixels BY -1 DO HorScrollRight; END;
    END;
  END HorizScroll;

  PROCEDURE ResetHorizScroll;
  BEGIN
    PelScrollColumn := 0;
    WaitForVerticalRetrace;
    EGAOutWord(AttributeCntrl, AttrHorizPelPan+PaletteOn, 0);
  END ResetHorizScroll;

     (*-------------------------------------------------*)
     (*         Vertical Scrolling                      *)
     (*      only has meaning in alpha modes            *)
     (*-------------------------------------------------*)

  PROCEDURE VerticalScrollUp;
    (* Smooth vertical scroll uses the Preset row scan register
       in the CRTC. When the row is completely scrolled,
       the offset pointer is advanced by one row size *)
  BEGIN
    INC(VerticalScrollRow);  WaitForVerticalDisplay;
    IF VerticalScrollRow >= INTEGER(BytesPerChar) THEN
      ActivePageOffset := ActivePageOffset + BiosCRTParams.CRTCols;
      VerticalScrollRow := 0;
      SetPageOffset(ActivePageOffset);
      EGAOutWord(EGA6845, CRTPreRowScan, VerticalScrollRow);
    ELSE
      WaitForVerticalRetrace;
      EGAOutWord(EGA6845, CRTPreRowScan, VerticalScrollRow);
    END;
  END VerticalScrollUp;

  PROCEDURE VerticalScrollDown;
    (* Vertical Scrolling down is the same as up except the row
       changes backward, each character row is brought down a line
       at a time by setting the preset row scan register to the
       high value and decrementing it. *)
  BEGIN
    DEC(VerticalScrollRow);  WaitForVerticalDisplay;
    IF VerticalScrollRow < 0 THEN
      ActivePageOffset := ActivePageOffset - BiosCRTParams.CRTCols;
      VerticalScrollRow := BytesPerChar - 1;
      SetPageOffset(ActivePageOffset);
      EGAOutWord(EGA6845, CRTPreRowScan, VerticalScrollRow);
    ELSE
      WaitForVerticalRetrace;
      EGAOutWord(EGA6845, CRTPreRowScan, VerticalScrollRow);
    END;
  END VerticalScrollDown;

  PROCEDURE ResetVerticalScroll;
  BEGIN
    WaitForVerticalRetrace;
    EGAOutWord(EGA6845, CRTPreRowScan,  0);
    VerticalScrollRow := 0;
  END ResetVerticalScroll;



  (*----------------------------------------------------*)
  (*     Split screen routines                          *)
  (*          The split screen starts at offset in the  *)
  (*           display buffer                           *)
  (*----------------------------------------------------*)

  PROCEDURE SplitScreenAt(ScanLine : CARDINAL);
    (* Splitting the screen uses the Line Compare Register of
       the CRTC. The overflow for the 9th bit is placed in the
       CRTC'c overflow register. The screen splits when the
       current video scan line equals the designated value
       in those two registers  *)
    VAR Line : Register;
  BEGIN
    Line.X := ScanLine;
    IF Line.H <> 0C THEN
      CRTCOverflowRegister := CRTCOverflowRegister + {4};
    ELSE
      CRTCOverflowRegister := CRTCOverflowRegister - {4}; END;
    WaitForVerticalDisplay;  WaitForVerticalRetrace;
    EGAOutWord(EGA6845, CRTLineCompare, ORD(Line.L));
    EGAOutWord(EGA6845, CRTOvflo,
               CARDINAL(CRTCOverflowRegister));
    SplitScreenLine := ScanLine;
  END SplitScreenAt;

  PROCEDURE RollSplitScreenUp(SplitSizeLines : CARDINAL);
    (* Smoothly bring up the split screen with a delay between
       each line as it is brought up.  *)
    VAR Line : CARDINAL;
  BEGIN
    Line := TotalVerticalScanLines - 1;
    WHILE Line > TotalVerticalScanLines - SplitSizeLines DO
      SplitScreenAt(Line);
      DEC(Line);
      WaitForVerticalRetrace;
    END;
  END RollSplitScreenUp;

  PROCEDURE RollSplitScreenDown;
    (* This routines smoothly rolls the split screen back down *)
    VAR Line : CARDINAL;
  BEGIN
    Line := SplitScreenLine + 1;
    WHILE Line < TotalVerticalScanLines DO
      SplitScreenAt(Line);
      INC(Line);
      WaitForVerticalRetrace;
    END;
  END RollSplitScreenDown;

  PROCEDURE ResetSplitScreen;
    (* This routine pops the split screen back down, no scrolling
       is performed. *)
  BEGIN
    SplitScreenAt(BottomOfScreen);
  END ResetSplitScreen;

  (*----------------------------------------------------*)
  (*       Graphics routines                            *)
  (*----------------------------------------------------*)

  PROCEDURE FillGraphicsPage(Color : CARDINAL);
     (* Modify to use writing mode 2: Set every bit in bit plane N
        equal to bit N of the data bytes. Useful for rapid flooding
        of the display ram with a particular palette. *)
     VAR x1, y1 : CARDINAL;
  BEGIN
    EGAOutWord(Graph12, GraphModeReg, 2);
    FOR x1 := 0 TO BiosCRTParams.CRTCols - 1 DO
      FOR y1 := 0 TO 349 DO
        DisplayBuffer[ActivePageOffset + x1 +
                      BiosCRTParams.CRTCols * y1] := CHR(Color);
      END;
    END;
    EGAOutWord(Graph12, GraphModeReg, 0)
  END FillGraphicsPage;

  PROCEDURE DrawPointTutorial(p : Point; color : CARDINAL);
  (* This procedure demonstrates the method for turing on
     one pixel. A faster version is below with key parts reduced
     to machine level code *)
  (* Turn on a dot at 'p', setting its 'color'. *)
    VAR  rowbyte, bitmask, byteoffset : CARDINAL;
         Temp : CHAR;
  BEGIN
    (* Here compute the address of the pixel byte to change,
       and its bit offset within the byte. *)
    rowbyte := p.x DIV 8;  bitmask := p.x MOD 8;
    bitmask := bitmasks[bitmask];
    byteoffset := CARDINAL(p.y) * BiosCRTParams.CRTCols + rowbyte
                     + ActivePageOffset;
    VIDEORAM.off := byteoffset;
    (*  Select Graphics Bit Mask Register to mask
        out all but the desired pixel *)
    EGAOutWord(Graph12, GraphBitMask, bitmask);
    (*  Select sequencer map mask to enable all four
        maps and latches even if 2 are present *)
    EGAOutWord(Sequencer, SequenceMapMask, 0FH);
    (* Now read the character to latch it in to the 4 EGA plane
       latches. The value read is of no importance *)
    Temp := VIDEORAM.adr^;
    (* Now blank out the all bytes, to clear out the desired
       pixel. Remember the other bits are still latched in, and
       will be preserved during this operation. *)
    VIDEORAM.adr^ := 0c;
    (* Select sequencer Map Mask to enable only writing to those
       bit planes with bits corresponding to the selected palette *)
    EGAOutWord(Sequencer, SequenceMapMask, color);
    (* Now write all bits out in parallel. The sequencer map
       mask and the board latches preserve all pixels except
       that to be set. *)
    VIDEORAM.adr^ := CHR(0FFH);
    (* Normalize the environment, by resetting the masks and
       the data rotation register *)
    EGAOutWord(Sequencer, SequenceMapMask, 0FH);
    EGAOutWord(Graph12, GraphDataRotate, 0);
    EGAOutWord(Graph12, GraphBitMask, 0FFH);
  END DrawPointTutorial;

(*$R-*)(*$S-*)(*$T-*)  (*Turn off overhead calls for speed *)

  PROCEDURE DrawPoint(p : Point; color : CARDINAL);
  (* Turn on a dot at 'p', with setting color *)
    VAR
      A : Register;
      rowbyte, bitmask, byteoffset : CARDINAL;
  BEGIN
    rowbyte := p.x DIV 8; (* After a divide dx has modulus *)
    GETREG(DX, bitmask);
    bitmask := bitmasks[bitmask];
    byteoffset := CARDINAL(p.y) * BiosCRTParams.CRTCols + rowbyte
                 + ActivePageOffset;
    SETREG(ES, VIDEORAM.seg);    SETREG(BX, byteoffset);
    SETREG(CX, color);           SETREG(AX, bitmask);
    CODE ( 88h, 0c4h, 0b0h, 08h, 0bah, 0ceh, 03h, 0efh, 0b8h, 02h,
          0ffh, 0b2h, 0c4h, 0efh, 26h, 08ah, 2fh, 26h, 0c6h, 07h,
          00h, 88h, 0cch, 0efh, 026h, 0c6h, 07h, 0ffh, 0b4h, 0ffh,
          0efh, 0b2h, 0ceh, 0b8h, 03h, 00h, 0efh, 0b8h, 08h, 0ffh,
          0efh);
  END DrawPoint;

(*$R+*)(*$S+*)(*$T+*)

(*------------------------------------------------------*)
(*           BIOS Interface Routines                    *)
(*------------------------------------------------------*)

PROCEDURE LoadBiosFont(Font : FontType; ResetFlag : BOOLEAN;
                       Block : CARDINAL);
  VAR A : Register;
BEGIN
  A.H := CHR(CharacterGeneratorFunction);
  A.L := CHR(ORD(Font));
  IF ResetFlag THEN A.L := CHR(ORD(A.L) + 011H);
               ELSE A.L := CHR(ORD(A.L) + 01H) END;
  SETREG(AX, A.X);
  SETREG(BX, Block);
  SWI(VIDEO);
END LoadBiosFont;

PROCEDURE LoadUserFont(VAR Font : ARRAY OF CHAR; ResetFlag : BOOLEAN;
                       Block, Count, Points : CARDINAL);
  VAR A, B : Register;
      f : ADDRESS;
BEGIN
  f := ADR(Font);
  A.H := CHR(CharacterGeneratorFunction);
  IF ResetFlag THEN A.L := CHR(010H);
               ELSE A.L := CHR(00H) END;
  B.H := CHR(Points);    B.L := CHR(Block);
  SETREG(CX, Count);     SETREG(BX, B.X);
  SETREG(AX, A.X);       CODE(PushBP); (*Save our BP *)
  SETREG(ES, f.SEGMENT); SETREG(DX, f.OFFSET);
  CODE(89H, 0D5H); (* MOV bp, dx ;Set BP to point at font *)
  SETREG(DX, 0);         SWI(VIDEO);
  CODE(PopBP);  (*Restore the BP *)
END LoadUserFont;

PROCEDURE GetAlternatePrintScreen;
BEGIN
  SETREG(AX, 01200H);    SETREG(BX, 0020H);
  SWI(VIDEO);
END GetAlternatePrintScreen;

PROCEDURE SetBiosPage(Page : CARDINAL);
  VAR A : Register;
BEGIN
  A.H := CHR(SetPageBiosCall); A.L := CHR(Page);
  SETREG(AX, A.X); SWI(VIDEO);
END SetBiosPage;

PROCEDURE SetBiosPalette(Palette, Color : CARDINAL);
  VAR A, B : Register;
BEGIN
  A.H := CHR(SetPaletteCall); A.L := 0C;
  B.H := CHR(Color); B.L := CHR(Palette);
  SETREG(BX, B.X); SETREG(AX, A.X);
  SWI(VIDEO);
END SetBiosPalette;

PROCEDURE SetModeBios(Mode : CARDINAL);
BEGIN
  SETREG (AX, Mode);
  SWI(VIDEO);
END SetModeBios;

PROCEDURE SetBiosCursorPoint(Page : CARDINAL; p : Point);
  VAR A, B, D : Register;
BEGIN
  A.H := CHR(SetCPos);  A.L := 0C;
  B.H := CHR(Page);     B.L := 0C;
  D.H := CHR(p.y);      D.L := CHR(p.x);
  SETREG(DX, D.X);      SETREG(BX, B.X);
  SETREG(AX, A.X);      SWI(VIDEO);
END SetBiosCursorPoint;

PROCEDURE WriteBios(c : CHAR; color : CARDINAL);
  VAR A, B : Register;
BEGIN
  A.H := CHR(WriteTTY); A.L := c;
  B.H := 0C;            B.L := CHR(color);
  SETREG(BX, B.X);      SETREG(AX, A.X);
  SWI(VIDEO);
END WriteBios;

PROCEDURE WriteBiosString(msg : ARRAY OF CHAR; color : CARDINAL);
    VAR i : CARDINAL;
BEGIN
  i := 0;
  WHILE i <= HIGH(msg) DO
    WriteBios(msg[i], color);
    INC(i);
  END;
END WriteBiosString;

PROCEDURE PrintScreen;
BEGIN
  SWI(05H);
END PrintScreen;


BEGIN
  VIDEORAM.seg := 0a000H;    VIDEORAM.off := 0;
  bitmasks[7] := 1;          bitmasks[6] := 2;
  bitmasks[5] := 4;          bitmasks[4] := 8;
  bitmasks[3] := 16;         bitmasks[2] := 32;
  bitmasks[1] := 64;         bitmasks[0] := 128;
  MakePoint(Cursors[0], 0, 0);
  FOR i := 1 TO MaxVideoPages DO Cursors[i] := Cursors[0]; END;
  FOR i := 0 TO MaxVideoPages DO
       ActivePageOffsets[i] := i * AlphaPageSize; END;
  PelScrollColumn := 0; VerticalScrollRow := 0;
  TotalVerticalScanLines := TotalScanLinesEnhanced;
  ActivePage := 0;
END LowEGA.